home *** CD-ROM | disk | FTP | other *** search
/ Sound Fx / Sound Fx.iso / Software / UNZIPED / DWSTK / MEM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-10-10  |  2.3 KB  |  107 lines
  1. (******************************************************************************
  2. File:          mem.pas
  3. Version:     2.22
  4. Tab stops: every 2 columns
  5. Project:   any STK related code
  6. Copyright: 1994-1995 DiamondWare, Ltd.    All rights reserved. *
  7. Written:     Erik Lorenzen
  8. DPMI Ver:  Tom Repstad
  9. Purpose:   Contains a routine to handle any error generated by the STK
  10. History:     95/10/18 EL Started
  11.                      95/10/25 EL Finalized for 2.20
  12.                      95/12/07 EL Finalized for 2.21, no changes
  13.                      96/10/10 EL Finalized for 2.22, no changes
  14.  
  15. Notes
  16. -----
  17. *Permission is expressely granted to use this unit or any derivitive made
  18.  from it to registered users of the STK.
  19. ******************************************************************************)
  20.  
  21.  
  22. unit mem;
  23.  
  24.  
  25. interface
  26.  
  27.  
  28. {$IFDEF DPMI}
  29.     uses crt, dws, winapi;
  30. {$ELSE}
  31.     uses crt, dws;
  32. {$ENDIF}
  33.  
  34.  
  35. procedure mem_GetDOS(var p : dws_ADDRESS; size : word);
  36.  
  37. procedure mem_FreeDOS(var p : dws_ADDRESS; size : word);
  38.  
  39.  
  40. implementation
  41.  
  42.  
  43. (*
  44.  . Please note that pointers in real mode and protected mode are different.
  45.  .
  46.  . In pmode the STK needs the pmode selector and the rmode segment and the
  47.  . offset.    This information will be encapsulted in the dws_ADDRESS struct.
  48. *)
  49.  
  50. (*
  51.  .        dws_ADDRESS = record
  52.  .            ptr     : pointer;
  53.  .            rmseg : longint;
  54.  .        end;
  55.  .
  56.  . If a variable is declared
  57.  .        var sound : dws_ADDRESS;
  58.  .
  59.  . It could be accessed like:
  60.  .        1) blockread(fp, sound.ptr^, soundsize);
  61.  .        2) blockread(fp, pointer(@sound)^, soundsize);
  62. *)
  63.  
  64. procedure mem_GetDOS(var p : dws_ADDRESS; size : word);
  65. {$IFDEF DPMI}
  66. var
  67.     tmp : longint;
  68. {$ENDIF}
  69.  
  70. begin
  71.     {$IFDEF DPMI}
  72.         (*
  73.          . GlobalDosAlloc returns a longint.    The high word is the
  74.          . real mode segment.  The low word is the protected mode
  75.          . selector.    The STK needs both of these values.
  76.         *)
  77.         tmp := GlobalDosAlloc(size);
  78.  
  79.         if tmp = 0 then
  80.         begin
  81.             writeln('Memory Allocation Failure');
  82.             exit;
  83.         end;
  84.  
  85.         p.ptr     := Ptr(word(tmp), 0); {Always starts at an offset of 0}
  86.         p.rmseg := word(tmp SHR 16);
  87.     {$ELSE}
  88.         getmem(p, size);
  89.     {$ENDIF}
  90. end;
  91.  
  92.  
  93. procedure mem_FreeDOS(var p : dws_ADDRESS; size : word);
  94. begin
  95.     {$IFDEF DPMI}
  96.         if GlobalDosFree(longint(p.ptr) SHR 16) <> 0 then
  97.         begin
  98.             writeln('Memory De-Allocation Failure');
  99.             exit;
  100.         end;
  101.     {$ELSE}
  102.         freemem(p, size);
  103.     {$ENDIF}
  104. end;
  105.  
  106. end.
  107.